(FILECREATED " 1-JUN-74 14:10:22" GI 9143  

     changes to:  FORALL, INSERT3, TAKE2, FORALL2, INSERT, PARSE, 
PARSE:FORWARD, PARSE:BACKWARD, PULLOUT, PULLOUT1, GIFNS

     previous date: "31-MAY-74 14:33:38")


(DEFINEQ

(TUPLE
  [NLAMBDA FORM
    (MAPCAR FORM (FUNCTION (LAMBDA (F2)
		(COND
		  ((ATOM F2)
		    F2)
		  (T (EVAL F2])

(@
  [LAMBDA (C)
    C])

(FOREACH
  [NLAMBDA (A IN B DO C)
    (EVAL (TUPLE MAPC (@ B)
		 (TUPLE FUNCTION (TUPLE LAMBDA (LIST A)
					(@ C])

(PULLOUT
  [LAMBDA (E L ETEMP)
    (COND
      ((PROGN (SETQ ETEMP (PULLOUT1 E L))
	      (NOT (EQUAL ETEMP L)))
	ETEMP)
      ((LISTP E)
	(MINTERSECTION (MAPCAR E (FUNCTION (LAMBDA (EE)
				   (PULLOUT1 EE L])

(PULLOUT1
  [LAMBDA (E L)
    (COND
      ((ATOM L)
	L)
      ((EQUAL E (CAR L))
	(CDR L))
      (T (CONS (CAR L)
	       (PULLOUT1 E (CDR L])

(MINTERSECTION
  [LAMBDA (LL)
    (COND
      ((ATOM LL)
	NIL)
      ((EQUAL (LENGTH LL)
	      1)
	(CAR LL))
      (T (INTERSECTION (CAR LL)
		       (MINTERSECTION (CDR LL])

(GETHOLD
  [NLAMBDA (ARG1)
    (FORALL POSSIBLE:NAME:OF:CLASS IN SET:OF:POSSIBLE:NAMES:OF:CLASS DO
	    (TESTT POSSIBLE:NAME:OF:CLASS])

(FORALL
  [NLAMBDA (A IN B DO C)
    (PROG (R2 EB)
          (SETQ EB (EVAL B))
      LABEL2
          [COND
	    ((NULL EB)
	      (SET A ???)
	      (RETURN (COMMENT I GIVE UP]
          (SET A (CAR EB))
          (SETQ EB (CDR EB))
          (SETQ R2 (EVAL C))
          (COND
	    ((NOT (EQUAL R2 NIL))
	      (RETURN (EVAL A)))
	    (T (GO LABEL2])

(INSERT3
  [LAMBDA (ARG1 ARG2)
    (SET ARG2 (APPEND ARG1 (EVAL ARG2)))
    (SET ARG2 (INTERSECTION (COPY (EVAL ARG2))
			    (COPY (EVAL ARG2])

(GRAM:INF
  [LAMBDA NIL
    (MAPC GLOBAL:INITIALIZATION:LIST (QUOTE EVAL))
    (PARTITION:DOMAIN])

(PARTITION:DOMAIN
  [LAMBDA NIL
    (PROG NIL
      LABEL1
          (TAKE ELEM)
          (SETQ RESULT1 (GETHOLD NAME:OF:CLASS))
          [COND
	    ((ISOFTYPE ELEM (COMMENT TAKE ELEANDCLASS))
	      (PROGN (TAKE2 (QUOTE NAME:OF:CLASS))
		     (COMPLEX:MODIFY NAME:OF:CLASS ELEM RESULT1)))
	    (T (PROGN (MESSAGE RESULT1)
		      (ASK:USER (QUOTE NAME:OF:CLASS))
		      (COND
			((NOT (EQUAL NAME:OF:CLASS ???))
			  (COMPLEX:MODIFY NAME:OF:CLASS ELEM RESULT1]
          [FOREACH NAME IN SET:OF:POSSIBLE:NAMES:OF:CLASS DO
		   (PROGN (PRINT NAME)
			  (TERPRI)
			  (PRINT (EVAL (PACK (TUPLE SET:OF:
						    (@ NAME)
						    :STRINGS]
          (PROGN (TERPRI)
		 (PRINT (QUOTE SET:OF:RULES))
		 (PRINT SET:OF:RULES))
          (GO LABEL1])

(COMMENT
  [NLAMBDA FORM
    (CONS COMMENT (MAPCAR FORM (FUNCTION (LAMBDA (F1)
			      (COND
				((ATOM F1)
				  F1)
				(T (EVAL F1])

(MESSAGE
  [LAMBDA (M)
    (PRINT M])

(TAKE
  [NLAMBDA (ARG1)
    (PROGN (PRINT (COMMENT READY TO ACCEPT NEW (@ ARG1)))
	   (SET ARG1 (READ))
	   (SETQ ELEM:CLASSNAME (CAR (EVAL ARG1)))
	   (SETQ ELEM:STRING (CDR (EVAL ARG1)))
	   T])

(TAKE2
  [LAMBDA (ARG1)
    (SET ARG1 ELEM:CLASSNAME])

(ISOFTYPE
  [LAMBDA (ARG1)
    (NOT (EQUAL (CAR ARG1)
		???])

(ASK:USER
  [LAMBDA (ARG1)
    (PRINT (COMMENT PLEASE GIVE ME (@ ARG1)))
    (SET ARG1 (READ])

(TESTT
  [LAMBDA (ARG1)
    (COMPARISON ARG1 ELEM])

(COMPARISON
  [LAMBDA (ARG1 ARG2)
    (JOIN T (COMPARE2 (EVAL ARG1)
		      (CDR ARG2])

(COMPARE2
  [LAMBDA (ARG1 ARG2)
    (APPLY* ARG1 ARG2])

(ILLEGAL
  [LAMBDA (ARG1)
    T])

(LEGAL
  [LAMBDA (ARG1)
    (PARSE ARG1])

(JOIN
  [LAMBDA (ARG1 ARG2)
    (AND ARG1 ARG2])

(PARSE
  [LAMBDA (ARG12)
    (SETQ RULES:USED NIL)
    (SETQ PARSE:TREE NIL)
    (FORALL2 S1 IN SET:OF:LEGAL:STRINGS DO
	     (OR (PARSE:FORWARD S1 ARG12 4)
		 (PARSE:BACKWARD S1 ARG12 3])

(PARSE:FORWARD
  [LAMBDA (ARG11 ARG22 ARG33 R AR)
    (COND
      ((EQUAL ARG11 ARG22)
	T)
      ((ZEROP ARG33)
	NIL)
      (T (FORALL2 R IN SET:OF:RULES DO
		  (FORALL2 AR IN (APPLYRULE R ARG11)
			   DO
			   (AND (PARSE:FORWARD AR ARG22 (SUB1 ARG33))
				(INSERT AR (QUOTE PARSE:TREE))
				(INSERT R (QUOTE RULES:USED])

(PARSE:BACKWARD
  [LAMBDA (ARG11 ARG22 ARG33 R AR)
    (COND
      ((EQUAL ARG11 ARG22)
	T)
      ((ZEROP ARG33)
	NIL)
      (T (FORALL2 R IN SET:OF:RULES DO
		  (FORALL2 AR IN (APPLYRULE (ANTI:RULE R)
					    ARG22)
			   DO
			   (AND (PARSE:BACKWARD ARG11 AR (SUB1 ARG33))
				(INSERT AR (QUOTE PARSE:TREE))
				(INSERT R (QUOTE RULES:USED])

(FORALL2
  [NLAMBDA (ARG1 IN ARG3 DO ARG5)
    (PROG (RESULT3 E3)
          (SETQ E3 (EVAL ARG3))
      LABEL3
          (COND
	    ((NULL E3)
	      (SET ARG1 NIL)
	      (RETURN NIL)))
          (SET ARG1 (CAR E3))
          (SETQ E3 (CDR E3))
          (SETQ RESULT3 (EVAL ARG5))
          (COND
	    ((NOT (EQUAL RESULT3 NIL))
	      (RETURN RESULT3))
	    (T (GO LABEL3])

(APPLYRULE
  [LAMBDA (ARG1 ARG2)
    (ALLSUBSTS (COPY (CADR ARG1))
	       (COPY (CAR ARG1))
	       (COPY ARG2])

(ALLSUBSTS
  [LAMBDA (NEW OLD L E B FLIST)
    (SETQ B NIL)
    (SETQ E L)
    [PROG NIL
      LABEL4
          [COND
	    ((HEAD OLD E)
	      (SETQ FLIST (CONS [APPEND B NEW
					(NTH E (ADD1 (LENGTH OLD]
				FLIST]
          (SETQ B (NCONC1 B (CAR E)))
          (SETQ E (CDR E))
          (COND
	    (E (GO LABEL4]
    FLIST])

(HEAD
  [LAMBDA (L1 L2)
    (COND
      [L1 (AND (EQUAL (CAR L1)
		      (CAR L2))
	       (HEAD (CDR L1)
		     (CDR L2]
      (T T])

(ANTI:RULE
  [LAMBDA (R)
    (LIST (CADR R)
	  (CAR R])

(COMPLEX:MODIFY
  [LAMBDA (ARG1 ARG2 ARG3)
    (NLSETQ (EVAL (TUPLE APPLY* (PACK (LIST ARG1 (QUOTE :)
					    ARG3
					    (QUOTE :MODIFY)))
			 (TUPLE CDR ARG2])

(LEGAL:ILLEGAL:MODIFY
  [LAMBDA (ARG1)
    (INSERT2 ARG1)
    [MAPC SET:OF:ILLEGAL:STRINGS (FUNCTION (LAMBDA (ILS)
	      (COND
		((PARSE ILS)
		  (DELETE (INTERSECTION RULES:USED 
					SET:OF:POSSIBLE:RULES)
			  SET:OF:RULES]
    (INSERT ARG1 (QUOTE SET:OF:LEGAL:STRINGS])

(INSERT
  [LAMBDA (ARG1 ARG2)
    (COND
      ((NOT (MEMBER ARG1 (EVAL ARG2)))
	(SET ARG2 (CONS ARG1 (EVAL ARG2])

(ILLEGAL:ILLEGAL:MODIFY
  [LAMBDA (ARG1)
    (INSERT ARG1 (QUOTE SET:OF:ILLEGAL:STRINGS])

(ILLEGAL:LEGAL:MODIFY
  [LAMBDA (ARG1)
    (UNTIL (NOT (PARSE ARG1))
	   DO
	   (DELETE (RANDOMSELECT RULES:USED SET:OF:RULES)
		   SET:OF:RULES))
    (INSERT ARG1 (QUOTE SET:OF:ILLEGAL:STRINGS])

(LEGAL:LEGAL:MODIFY
  [LAMBDA (ARG1)
    (INSERT ARG1 (QUOTE SET:OF:LEGAL:STRINGS])

(DELETE
  [NLAMBDA (ARG1 ARG2)
    (SET ARG2 (PULLOUT (EVAL ARG1)
		       (EVAL ARG2])

(UNTIL
  [NLAMBDA (ARG1 DO ARG2)
    (PROG NIL
      LABEL5
          (EVAL ARG2)
          (COND
	    ((EVAL ARG1))
	    (T (GO LABEL5])

(INSERT2
  [LAMBDA (ARG1)
    (INSERT3 [SETQ SET:OF:POSSIBLE:RULES
	       (MAPCONC SET:OF:LEGAL:STRINGS
			(FUNCTION (LAMBDA (LS)
			    (COND
			      ((ISOFTYPE2 (MATCH2 LS ARG1))
				(LIST (LIST MATCH:DIFF:LEFT 
					    MATCH:DIFF:RIGHT)
				      (LIST MATCH:DIFF:RIGHT 
					    MATCH:DIFF:LEFT]
	     (QUOTE SET:OF:RULES])

(ISOFTYPE2
  [LAMBDA (AG1)
    (AND MATCH:DIFF:LEFT MATCH:DIFF:RIGHT (LESSP (LENGTH (APPEND 
						    MATCH:DIFF:LEFT 
						   MATCH:DIFF:RIGHT))
						 8])

(MATCH2
  [LAMBDA (ARG19 ARG29)
    (ELIM:COMMON:HEAD ARG19 ARG29 (QUOTE ARG19)
		      (QUOTE ARG29))
    (ELIM:COMMON:TAIL ARG19 ARG29 (QUOTE ARG19)
		      (QUOTE ARG29))
    (SETQ MATCH:DIFF:LEFT ARG19)
    (SETQ MATCH:DIFF:RIGHT ARG29])

(ELIM:COMMON:HEAD
  [LAMBDA (A B NA NB)
    (COND
      ((AND A B (EQUAL (CAR A)
		       (CAR B)))
	(ELIM:COMMON:HEAD (CDR A)
			  (CDR B)
			  NA NB))
      (T (SET NA A)
	 (SET NB B])

(ELIM:COMMON:TAIL
  [LAMBDA (A B NA NB)
    (ELIM:COMMON:HEAD (REVERSE A)
		      (REVERSE B)
		      NA NB)
    (SET NA (REVERSE (EVAL NA)))
    (SET NB (REVERSE (EVAL NB])

(RANDOMSELECT
  [LAMBDA (S1 S2)
    (COND
      [S1 (CAR (NTH S1 (RAND 1 (LENGTH S1]
      [S2 (CAR (NTH S2 (RAND 1 (LENGTH S2]
      (T (PRINT (COMMENT UNABLE TO MAKE A SELECTION))
	 NIL])
)
  (LISPXPRINT (QUOTE GIFNS)
	      T)
  (RPAQQ GIFNS
	 (TUPLE @ FOREACH PULLOUT PULLOUT1 MINTERSECTION GETHOLD FORALL 
		INSERT3 GRAM:INF PARTITION:DOMAIN COMMENT MESSAGE TAKE 
		TAKE2 ISOFTYPE ASK:USER TESTT COMPARISON COMPARE2 
		ILLEGAL LEGAL JOIN PARSE PARSE:FORWARD PARSE:BACKWARD 
		FORALL2 APPLYRULE ALLSUBSTS HEAD ANTI:RULE 
		COMPLEX:MODIFY LEGAL:ILLEGAL:MODIFY INSERT 
		ILLEGAL:ILLEGAL:MODIFY ILLEGAL:LEGAL:MODIFY 
		LEGAL:LEGAL:MODIFY DELETE UNTIL INSERT2 ISOFTYPE2 
		MATCH2 ELIM:COMMON:HEAD ELIM:COMMON:TAIL RANDOMSELECT))
  (LISPXPRINT (QUOTE GIVARS)
	      T)
  [RPAQQ GIVARS (GLOBAL:INITIALIZATION:LIST
	   (P (MAPC GIFNS (FUNCTION (LAMBDA (V)
					    (SET V V]
  (RPAQQ GLOBAL:INITIALIZATION:LIST ((SETQQ 
				     SET:OF:POSSIBLE:NAMES:OF:CLASS
					    (LEGAL ILLEGAL))
	  (SETQQ SET:OF:LEGAL:STRINGS ((S)))
	  (SETQ SET:OF:ILLEGAL:STRINGS NIL)
	  (SETQQ ??? ???)
	  (SETQ SET:OF:RULES NIL)))
  [MAPC GIFNS (FUNCTION (LAMBDA (V)
				(SET V V]
(PROGN (QUOTE JUSTEVALUATE)
(FILEMAP (NIL (221 8122 (TUPLE 233 . 352) (@ 356 . 382) (FOREACH 386
. 505) (PULLOUT 509 . 727) (PULLOUT1 731 . 881) (MINTERSECTION 885
. 1069) (GETHOLD 1073 . 1211) (FORALL 1215 . 1583) (INSERT3 1587 .
1735) (GRAM:INF 1739 . 1840) (PARTITION:DOMAIN 1844 . 2616) (COMMENT
2620 . 2762) (MESSAGE 2766 . 2805) (TAKE 2809 . 3011) (TAKE2 3015
. 3071) (ISOFTYPE 3075 . 3139) (ASK:USER 3143 . 3240) (TESTT 3244
. 3297) (COMPARISON 3301 . 3391) (COMPARE2 3395 . 3452) (ILLEGAL 3456
. 3491) (LEGAL 3495 . 3538) (JOIN 3542 . 3592) (PARSE 3596 . 3790)
(PARSE:FORWARD 3794 . 4128) (PARSE:BACKWARD 4132 . 4490) (FORALL2
4494 . 4885) (APPLYRULE 4889 . 5006) (ALLSUBSTS 5010 . 5355) (HEAD
5359 . 5500) (ANTI:RULE 5504 . 5562) (COMPLEX:MODIFY 5566 . 5735)
(LEGAL:ILLEGAL:MODIFY 5739 . 6022) (INSERT 6026 . 6143) (
ILLEGAL:ILLEGAL:MODIFY 6147 . 6238) (ILLEGAL:LEGAL:MODIFY 6242 . 6443)
(LEGAL:LEGAL:MODIFY 6447 . 6532) (DELETE 6536 . 6626) (UNTIL 6630
. 6774) (INSERT2 6778 . 7119) (ISOFTYPE2 7123 . 7286) (MATCH2 7290
. 7538) (ELIM:COMMON:HEAD 7542 . 7737) (ELIM:COMMON:TAIL 7741 . 7920)
(RANDOMSELECT 7924 . 8119)))))
STOP